home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 17 / AMIGAplus Sonderheft 17 (1999)(ICP)(DE)[!].iso / Rexx / AnimBrushToAnim.pprx < prev    next >
Text File  |  1997-05-06  |  4KB  |  174 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1995-1997 Cloanto Italia srl */
  2.  
  3. /* $VER: AnimBrushToAnim.pprx 1.2 */
  4.  
  5. /** ENG
  6.   This script converts the current anim-brush into an animation, creating
  7.   the animation in the current environment.
  8.  
  9.   This script performs a format conversion. It does not "paste" all
  10.   anim-brush frames to a specific position of the current animation,
  11.   as can be done by pressing a mouse button when <Caps Lock> is on.
  12. */
  13.  
  14. /** DEU
  15.   Dieses Skript wandelt den aktuellen AnimBrush in eine Animation um. Dabei
  16.   wird die aktuelle Arbeitsumgebung verwendet.
  17.  
  18.   Dieses Skript führt eine Formatkonvertierung durch. Dabei werden jedoch
  19.   nicht alle Einzelbilder eines Animationspinsels an eine bestimmte Position
  20.   einer Animation kopiert; hierzu ist bei aktiver <Caps lock>-Taste eine
  21.   Maustaste zu drücken.
  22. */
  23.  
  24. /** ITA
  25.   Questo script converte l'anim-brush corrente in un'animazione, creando
  26.   l'animazione nell'ambiente attivo.
  27.  
  28.   Questo script effettua una conversione di formato. Non "incolla" tutti i
  29.   fotogrammi di anim-brush in una specifica posizione dell'animazione corrente,
  30.   come si può fare premendo un tasto del mouse quando <Caps Lock> è
  31.   attivo.
  32. */
  33.  
  34. IF ARG(1, EXISTS) THEN
  35.     PARSE ARG PPPORT
  36. ELSE
  37.     PPPORT = 'PPAINT'
  38.  
  39. IF ~SHOW('P', PPPORT) THEN DO
  40.     IF EXISTS('PPaint:PPaint') THEN DO
  41.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  42.         DO 30 WHILE ~SHOW('P',PPPORT)
  43.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  44.         END
  45.     END
  46.     ELSE DO
  47.         SAY "Personal Paint could not be loaded."
  48.         EXIT 10
  49.     END
  50. END
  51.  
  52. IF ~SHOW('P', PPPORT) THEN DO
  53.     SAY 'Personal Paint Rexx port could not be opened'
  54.     EXIT 10
  55. END
  56.  
  57. ADDRESS VALUE PPPORT
  58. OPTIONS RESULTS
  59. OPTIONS FAILAT 10000
  60.  
  61. Get 'LANG'
  62. IF RESULT = 1 THEN DO        /* Deutsch */
  63.     txt_err_nofrm     = 'Frameerstellung für Umgebung_nicht möglich'
  64.     txt_err_nofmt     = 'Einstellung des Umgebungsformats_nicht möglich.'
  65.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  66. END
  67. ELSE IF RESULT = 2 THEN DO        /* Italiano */
  68.     txt_err_nofrm     = 'Impossibile trovare fotogrammi'
  69.     txt_err_nofmt     = 'Impossibile impostare formato'
  70.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  71. END
  72. ELSE DO        /* English */
  73.     txt_err_nofrm     = 'Environment frames_cannot be created'
  74.     txt_err_nofmt     = 'Environment format_cannot be set'
  75.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  76. END
  77.  
  78. Version 'REXX'
  79. IF RESULT < 7 THEN DO
  80.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  81.     EXIT 10
  82. END
  83.  
  84. FreeEnvironment 'QUERY'
  85. IF RC ~= 0 THEN
  86.     EXIT RC
  87.  
  88.  
  89. LockGUI
  90. loaded = 0
  91. GetBrushAttributes 'FRAMES'
  92. frnum = RESULT
  93. IF frnum = 0 THEN DO
  94.     LoadAnimBrush
  95.     IF RC = 0 THEN DO
  96.         GetBrushAttributes 'FRAMES'
  97.         frnum = RESULT
  98.         loaded = 1
  99.     END
  100. END
  101. IF frnum > 0 THEN DO
  102.     GetBrushAttributes 'WIDTH'
  103.     bw = RESULT
  104.     GetBrushAttributes 'HEIGHT'
  105.     bh = RESULT
  106.     GetBrushAttributes 'COLORS'
  107.     bcol = RESULT
  108.     GetBrushAttributes 'DISPLAY'
  109.     bdisp = RESULT
  110.     GetBrushAttributes 'HANDLEX'
  111.     bhx = RESULT
  112.     GetBrushAttributes 'HANDLEY'
  113.     bhy = RESULT
  114.     GetBrushAttributes 'LENGTH'
  115.     bfl = RESULT
  116.     GetBrushAttributes 'FRAMEPOSITION'
  117.     bfp = RESULT
  118.  
  119.     GetVideoModeInfo bdisp
  120.     IF RC ~= 0 THEN DO
  121.         GetBestVideoMode 'WIDTH' bw 'HEIGHT' bh 'COLORS' bcol 'ANIMATION'
  122.         PARSE VAR RESULT bdisp .
  123.     END
  124.  
  125.     Get 'GCLIP'
  126.     saveclip = RESULT
  127.     Set '"GCLIP=0"'
  128.  
  129.     DeleteFrames 'ALL FORCE'
  130.     ClearImage 'FORCE'
  131.     del_anim = 1
  132.  
  133.     Set '"IMAGEW='bw'" "IMAGEH='bh'" "COLORS='bcol'" "DISPLAY='bdisp'" "SCREENW='bw'" "SCREENH='bh'" "ASCROLL=0"'
  134.     IF RC ~= 0 THEN DO
  135.         GetBestVideoMode 'WIDTH' bw 'HEIGHT' bh 'COLORS' bcol
  136.         PARSE VAR RESULT bdisp .
  137.         Set '"IMAGEW='bw'" "IMAGEH='bh'" "COLORS='bcol'" "DISPLAY='bdisp'" "SCREENW='bw'" "SCREENH='bh'" "ASCROLL=0"'
  138.     END
  139.     IF RC = 0 THEN DO
  140.         UseBrushPalette
  141.         AddFrames frnum
  142.         SetFrameDelay 0 'ALL'
  143.         IF RC = 0 THEN DO
  144.             SetFramePosition 1
  145.             SetBrushAttributes 'HANDLEX 0 HANDLEY 0 LENGTH' frnum 'FRAMEPOSITION 1'
  146.             SetPaintMode 'REPLACE'
  147.             DO frm = 1 TO frnum
  148.                 PutBrush 0 0
  149.                 UseBrushPalette
  150.                 SetFramePosition 'NEXT'
  151.             END
  152.             SaveAnimation
  153.             IF RC = 5 THEN
  154.                 del_anim = 0
  155.         END
  156.         ELSE
  157.             RequestNotify 'PROMPT "'txt_err_nofrm'"'
  158.     END
  159.     ELSE
  160.         RequestNotify 'PROMPT "'txt_err_nofmt'"'
  161.  
  162.     SetBrushAttributes 'HANDLEX' bhx 'HANDLEY' bhy 'LENGTH' bfl 'FRAMEPOSITION' bfp
  163.  
  164.     IF del_anim THEN DO
  165.         DeleteFrames 'ALL FORCE'
  166.         ClearImage 'FORCE'
  167.     END
  168.     Set '"GCLIP='saveclip'"'
  169. END
  170. IF loaded THEN
  171.     FreeBrush 'FORCE'
  172.  
  173. UnlockGUI
  174.